COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(*$L+*)
C00011 ENDMK
C⊗;
(*$L+*)
PROGRAM SORT(INPUT*,OUTPUT,FILEK*,FILE1,FILE2,FILE3,FILE4));

(**********************************************************************)
CONST
MAXSORT=	1000;
MAXINDX=	1001;
MAXSTACK=	200;
M=		9;
INFINITY=	2147483647;

TYPE
SORTINDX=	0 .. MAXINDX;
BYTEINDX=	0 .. 5;
KEYINDX=	0..80;
SORTITEM=	INTEGER;
SORTARY=	ARRAY [SORTINDX] OF SORTITEM;
TMPINDX=	0 .. 21;
TMPARY=		ARRAY [TMPINDX] OF INTEGER;
KEYARY=		ARRAY [KEYINDX] OF INTEGER;
FILEK=		FILE OF CHAR;
FILE1=		FILE OF CHAR;
FILE2=		FILE OF CHAR;
FILE3=		FILE OF CHAR;
FILE4=		FILE OF CHAR;

VAR

A:		SORTARY;
KEY:		KEYARY;
(**********************************************************************)
PROCEDURE GETKEY(VAR KEY: KEYARY);
LABEL 1,2;

VAR
J:	KEYINDX;
K:	INTEGER;
C:	CHAR;

BEGIN
FOR J:=1 TO 80 DO KEY[J]:=0;
RESET(FILEK);
J:=1; K:=0;  
WHILE NOT EOF DO BEGIN
1:
  READ(FILEK,C); IF C>='0' THEN IF C<='9' THEN BEGIN
    K:=K*10+ORD(C); GOTO 1; END;
  IF K<>0 THEN BEGIN
    KEY[J]:=K; K:=0; J:=J+1; END;
  IF J>80 THEN GOTO 2;
END;
2:
END;

(**********************************************************************)
(*
PROCEDURE RUN0(VAR A: SORTARY, KEY: KEYARY);
VAR
C:	CHAR;
CK:	CHAR;

BEGIN
J:←1;  A[J]:=0;  K:←0
RESET(INPUT);
FOR I:=1 TO MAXSORT DO BEGIN
  READ(INPUT,C); GET(INPUT);
  IF CH=CHR(13) THEN GOTO 2;
  IF CH=CHK THEN BEGIN
    A[J]:=ORD(CH)
END;
*)
(**********************************************************************)
PROCEDURE WRTINT(I,LEN: INTEGER);

VAR
POW10:	INTEGER;
NEG:	BOOLEAN;
DIGS:	INTEGER;
TMP:	INTEGER;

BEGIN

  NEG:=FALSE;
  IF I<0 THEN BEGIN
    LEN:=LEN-1;
    NEG:=TRUE;
    I:=-I;
  END;

  DIGS:=0;
  TMP:=I;
  POW10:=1;
  REPEAT
    TMP:=TMP DIV 10;
    POW10:=POW10*10;
    DIGS:=DIGS+1;
  UNTIL TMP=0;

  FOR TMP:=LEN DOWNTO DIGS DO BEGIN
    WRITE(' ');
  END;

  IF NEG THEN BEGIN
    WRITE('-');
  END;
  
  REPEAT
    POW10:=POW10 DIV 10;
    TMP:=I DIV POW10;
    WRITE(CHR(TMP+ORD('0')));
    I:=I MOD POW10;
  UNTIL POW10=1;

END;
(**********************************************************************)

PROCEDURE INITARY(VAR ARY: SORTARY);

CONST
A=	54321;
B=	4;
C=	0;
D=	512;
M=	59999;
N=	43;

VAR
I:	SORTINDX;
J:	BYTEINDX;
K:	INTEGER;
RAND:	INTEGER;

BEGIN

RAND:=12345;
FOR I:=1 TO MAXINDX DO BEGIN
  K:=0;
  FOR J:=1 TO B DO BEGIN
    RAND:=((A*RAND+C) MOD M);
    K:=K*D+(RAND MOD N);
  END;
  ARY[I]:=K;
END;
  
END;
(**********************************************************************)
PROCEDURE PRTARY(VAR A: SORTARY);

CONST
B=	4;
D=	512;

VAR
I:	SORTINDX;
J:	INTEGER;
K:	INTEGER;

BEGIN

REWRITE(OUTPUT);
FOR I:=1 TO MAXSORT DO BEGIN
  K:=(A[I] DIV (D*D*D));
  WRITE(K:6);
  J:=K*D;
  K:=(A[I] DIV (D*D))-J;
  WRITE(K:6);
  J:=(J+K)*D;
  K:=(A[I] DIV D)-J;;
  WRITE(K:6);
  J:=(J+K)*D;
  K:=A[I]-J;
  WRITE(K:6);
  K:=0;
  WRITELN(OUTPUT);
END;

END;
(**********************************************************************)
PROCEDURE PRTCHAR(VAR A: SORTARY);

CONST
B=	4;
D=	512;

VAR
I:	SORTINDX;
J:	INTEGER;
K:	INTEGER;

BEGIN

FOR I:=1 TO MAXSORT DO BEGIN
  K:=(A[I] DIV (D*D*D));
  WRITE(CHR(K+ORD('0')));
  J:=K*D;
  K:=(A[I] DIV (D*D))-J;
  WRITE(CHR(K+ORD('0')));
  J:=(J+K)*D;
  K:=(A[I] DIV D)-J;;
  WRITE(CHR(K+ORD('0')));
  J:=(J+K)*D;
  K:=A[I]-J;
  WRITE(CHR(K+ORD('0')));
    J:=I MOD 10;
    IF J=0 THEN
  WRITELN(OUTPUT);
END;
WRITELN(OUTPUT);
END;
(**********************************************************************)
PROCEDURE TREE(VAR A: SORTARY);

LABEL	1,2;

VAR
I,
K:	SORTINDX;
J:	INTEGER;
T:	SORTITEM;

BEGIN

FOR I:=2 TO MAXINDX DO BEGIN
  K:=I;
  J:=I;
  T:=A[I];

  REPEAT
    J:=J DIV 2;
    IF T<=A[J] THEN GOTO 1;
    A[K]:=A[J];
    K:=J;
  UNTIL J=1;

  1:
  A[K]:=T;
END;

FOR I:=MAXINDX-1 DOWNTO 1 DO BEGIN
  T:=A[I+1];
  A[I+1]:=A[1];
  K:=1;
  J:=2;
  WHILE J<=I DO BEGIN
    IF J<I THEN IF (A[J+1]>A[J]) THEN J:=J+1;
    IF A[J]>T THEN BEGIN
      A[K]:=A[J];
      K:=J;
      J:=2*J;
    END ELSE GOTO 2;
  END;

  2:
  A[K]:=T;
END;

END;

(**********************************************************************)
PROCEDURE QUICK(VAR A: SORTARY);
LABEL	1,2,3,4,5,6;
VAR
P,
L,
R,
I,
J,
T:	INTEGER;
TMP,
V:	SORTITEM;
STACK:	ARRAY [0 .. MAXSTACK] OF INTEGER;

BEGIN

A[0]:=-INFINITY;
A[MAXSORT+1]:=INFINITY;

P:=0; L:=1; R:=MAXSORT;

1:
I:=L; J:=R+1; V:=A[L];
WHILE I<J DO BEGIN
  I:=I+1; WHILE A[I]<V DO I:=I+1;
  J:=J-1; WHILE A[J]>V DO J:=J-1;
  TMP:=A[J];
  A[J]:=A[I];
  A[I]:=TMP;
END;
TMP:=A[J];
A[J]:=A[L];
A[L]:=A[I];
A[I]:=TMP;
IF (R-J)>(J-L) THEN GOTO 3;
IF (J-L)<=M THEN GOTO 5;
IF (R-J)<=M THEN GOTO 4;
P:=P+2;
STACK[P]:=L;
STACK[P+1]:=J-1;

2:
L:=J+1;
GOTO 1;

3:
IF (R-J)<=M THEN GOTO 5;
IF (J-L)<=M THEN GOTO 2;
P:=P+2;
STACK[P]:=J+1;
STACK[P+1]:=R;

4:
R:=J-1;
GOTO 1;

5:
L:=STACK[P];
R:=STACK[P+1];
P:=P-2;
IF P>=0 THEN GOTO 1;

6:
FOR I:=2 TO MAXSORT DO BEGIN
  V:=A[I];
  J:=I-1;
  WHILE A[J]>V DO BEGIN
    A[J+1]:=A[J];
    J:=J-1;
  END;
  A[J+1]:=V;
END;

END;

(**********************************************************************)

BEGIN

INITARY(A);
REWRITE(OUTPUT);
(*PRTARY(A);*)
PRTCHAR(A);
QUICK(A);
(*TREE(A);*)
PRTCHAR(A);
(*REPACK(A);*)
(*PRTARY(A);*)

END.
(**********************************************************************)